home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / zebu-dump.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  6.4 KB  |  194 lines  |  [TEXT/ttxt]
  1. ; -*- mode:     CL -*- ------------------------------------------------- ;
  2. ; File:         dump.l
  3. ; Description:  Conversion to CL of the original Scheme program by (W M Wells)
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:      31-Oct-90
  6. ; Modified:     Mon Apr 11 14:11:34 1994 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      ZEBU
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1990, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ; 16-Jul-91 (Joachim H. Laubsch)
  17. ;  to deal with multiple-grammars, begin a ".tab" file with *GRAMMAR-OPTIONS*
  18. ;  a keyworded arglist that can be passed to MAKE-GRAMMAR
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;;             Copyright (C) 1989, by William M. Wells III
  21. ;;;                         All Rights Reserved
  22. ;;;     Permission is granted for unrestricted non-commercial use.
  23.  
  24. ;;;
  25. ;;; Dump parsing tables and associated stuff into a file.
  26. ;;;
  27. ;;; The follwing stuff is dumped in parenthesized lists which a lisp reader
  28. ;;; should be able to read:
  29. ;;;
  30. ;;; A keyword argument list for the MAKE-GRAMMAR function.
  31. ;;; An ordered (by grammar symbol index) lexicon.
  32. ;;; A list of the indices of terminal grammar symbols.
  33. ;;; A list of production info, ordered by production index, of lists
  34. ;;;    containing the index of the lhs grammar symbol and the length
  35. ;;;    of the rhs of the production.
  36. ;;; A sparse list of lists representation of the action function
  37. ;;;    (eyball one and you'll get the idea...).
  38. ;;; A similar representation of the goto function.
  39. ;;; The index of the start state.
  40. ;;; The index of the end symbol.
  41. ;;; A list of the client lambda forms.
  42.  
  43. (in-package "ZEBU")
  44. (declaim (special *ACTION-ARRAY* *GOTO-ARRAY* *LR0-START-STATE-INDEX*))
  45.  
  46. (defun dump-tables (grammar-file output-file)
  47.   (macrolet ((delete! (item sequence)
  48.            `(delete ,item ,sequence :test #'equal)))
  49.     (let ((*print-structure* t)
  50.       *print-pretty* *print-length* *print-level* *print-circle*
  51.       (filename (if output-file
  52.             (pathname output-file)
  53.               (merge-pathnames
  54.                (make-pathname :type "tab")
  55.                grammar-file))))
  56.       (format t "~%Dumping parse tables to ~A~%" filename)
  57.       (with-open-file (port filename :if-does-not-exist :create
  58.                 :if-exists :supersede
  59.                 :direction :output)
  60.     ;; 1: Dump options
  61.     (format port "~%~S" *grammar-options*)
  62.     ;; 2: Dump out an ordered lexicon.
  63.     (let ((ln (length *g-symbol-alist*)))
  64.       (format port "~%#~S(" ln)
  65.       (dolist (pair (reverse *g-symbol-alist*))
  66.         (format port "~S " (car pair)))
  67.       (format port ")~%~%"))
  68.     ;; 3: Dump a list of the indices of terminal grammar symbols
  69.     ;; deal with some special cases... .
  70.     (let ((gs-list (delete
  71.             '()
  72.             (delete!
  73.              *empty-string-g-symbol*
  74.              (delete!
  75.               *augmented-start-g-symbol*
  76.               (delete!
  77.                *the-end-g-symbol*
  78.                (mapcar #'(lambda (gs)
  79.                        (unless (g-symbol-non-terminal? gs) gs))
  80.                    (reverse *symbols*))))))))
  81.       (format port "~%#~S(" (length gs-list))
  82.       (dolist (gs gs-list)
  83.         (format port "~S " (g-symbol-index gs)))
  84.       (format port ")~%~%"))
  85.     ;; 4: productions
  86.     ;; For the lr parser, dump a list of info on the productions.
  87.     ;; The order of the list follows the productions indices in
  88.     ;; the parse tables.  Each element is a list of the index of
  89.     ;; the lhs grammar symbol and the length of the rhs of the production.
  90.     (format port "#~S(" (length *productions*))
  91.     (dolist (prod (reverse *productions*))
  92.       (format port "(~S . ~S)"
  93.           (g-symbol-index (lhs prod))
  94.           (production-length prod)))
  95.     (format port ")~%")
  96.  
  97.     ;; 5: Dump out a representation of the action function.
  98.     (let ((aa-len (length (the vector *action-array*))))
  99.       (format port "~%#~S(" aa-len)
  100.       (dotimes (i aa-len)
  101.         (format port "~%~S" (oset-item-list (svref *action-array* i))))
  102.       (format port ")~%"))
  103.  
  104.     ;; 6: Dump out a representation of the goto function for non-terminals
  105.     (let ((ga-len (length (the vector *action-array*))))
  106.       (format port "~%#~S(" ga-len)
  107.       (dotimes (i (length *goto-array*))
  108.         (format port "~%(")
  109.         (dolist (item (oset-item-list (svref *goto-array* i)))
  110.           (format port "~S" item))
  111.         (format port ")"))
  112.       (format  port ")"))
  113.  
  114.     ;; 7: Dump the index of the start state.
  115.     (print *lr0-start-state-index* port)
  116.     (terpri port) 
  117.  
  118.     ;; 8: Dump the index of the end symbol.
  119.     (print (g-symbol-index *the-end-g-symbol*) port)
  120.     (terpri port)
  121.  
  122.     ;; 9: Dump out a vector of the client lambdas
  123.     (let (*print-pretty*)
  124.           (format port "~%#~S(~{~S~%~})" 
  125.                   (length *zb-rules*)
  126.           (setq *zb-rules* (nreverse *zb-rules*))))
  127.     )
  128.       filename)))
  129.  
  130. ;; Set up some convenient ways to process grammars.
  131.  
  132. (defun compile-slr-grammar (grammar-file &rest args)
  133.   (apply #'compile-zebu-grammar-aux
  134.      grammar-file
  135.      #'slr-tables-from-grammar
  136.      args))
  137.  
  138. (defun compile-lalr1-grammar (grammar-file &rest args)
  139.   (apply #'compile-zebu-grammar-aux
  140.      grammar-file
  141.      #'lalr1-tables-from-grammar
  142.      args))
  143.  
  144. (declaim (special *compiler-grammar*))
  145. (defun compile-zebu-grammar-aux
  146.     (grammar-file compiler
  147.           &key
  148.           (output-file (merge-pathnames
  149.                 (merge-pathnames
  150.                  (make-pathname :type "tab")
  151.                  grammar-file)
  152.                 #+LUCID (working-directory)))
  153.           (grammar *null-grammar*)
  154.           verbose
  155.           (compile-domain t))
  156.   (let ((*compiler-grammar* grammar)
  157.     (*package* *package*))
  158.     (setq grammar-file (funcall compiler grammar-file))
  159.     (let ((domain-file (dump-domain-file grammar-file verbose)))
  160.       (when (and compile-domain domain-file)
  161.     (compile-file
  162.      domain-file
  163.      :output-file (merge-pathnames
  164.                (make-pathname
  165.             :name      (pathname-name domain-file)
  166.             :directory (pathname-directory output-file)
  167.             :type      (car *load-binary-pathname-types*)))
  168.      )))
  169.     (dump-tables grammar-file output-file)))
  170.  
  171. ;;;;;;;;;;;;;
  172. ;;; test:
  173. #||
  174. (set-working-directory *ZEBU-test-directory*)
  175. (compile-slr-grammar "ex1.zb")
  176. (compile-slr-grammar "ex2.zb")
  177.  
  178. ;; fails : not slr
  179. (compile-slr-grammar "ex3.zb") 
  180. ;;(compile-slr-grammar "ex4.zb")
  181.  
  182. ;; fails : not slr
  183. (compile-slr-grammar "ex6-2.zb") 
  184. (compile-lalr1-grammar "ex1.zb")
  185. (compile-lalr1-grammar "ex2.zb")
  186. (compile-lalr1-grammar "ex3.zb")
  187. (compile-lalr1-grammar "ex4.zb")
  188. (compile-lalr1-grammar "ex6-2.zb")
  189.  
  190. ||#
  191. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  192. ;;                                End of dump.l
  193. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  194.